home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / FILES / NAMES2U2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-07  |  3.3 KB  |  133 lines
  1. unit Names2u2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.   TDataRec = packed record
  10.     { The form's edit box has its MaxLength property set to 30 }
  11.     Name: String[30];
  12.     { Only interested in the date portion of this date/time value }
  13.     DOB: TDateTime;
  14.   end;
  15.  
  16.   TDataFile = class
  17.   private
  18.     FDataFile: File;
  19.   protected
  20.     function GetCount: Longint;
  21.     function GetCurrent: Longint;
  22.     function GetRecord(Index: Longint): TDataRec;
  23.     procedure SetCurrent(RecNo: Longint);
  24.     procedure SetRecord(Index: Longint; const DataRec: TDataRec);
  25.   public
  26.     constructor Create;
  27.     destructor Destroy; override;
  28.     property Count: Longint read GetCount;
  29.     property Current: Longint
  30.       read GetCurrent write SetCurrent;
  31.     property Records[Index: Longint]: TDataRec
  32.       read GetRecord write SetRecord; default;
  33.   end;
  34.  
  35. implementation
  36.  
  37. uses
  38.   Forms, NetLock, Consts, Classes;
  39.  
  40. const
  41.   FileName = 'DataFile.Dat';
  42.  
  43. constructor TDataFile.Create;
  44. begin
  45.   { Make current directory where EXE file is, just in case }
  46.   ChDir(ExtractFilePath(Application.ExeName));
  47.   AssignFile(FDataFile, FileName);
  48.   FileMode := fmOpenReadWrite or fmShareDenyNone;
  49.   try
  50.     { Make file if it ain't there }
  51.     if not FileExists(FileName) then
  52.       Rewrite(FDataFile);
  53.     Reset(FDataFile, SizeOf(TDataRec));
  54.   except
  55.     on E: EInOutError do
  56.     begin
  57.       { In case Rewrite succeeded but Reset failed }
  58.       if TFileRec(FDataFile).Mode = fmInOut then
  59.         CloseFile(FDataFile);
  60.       { Customise the exception and re-raise it }
  61.       E.Message := 'Failed to create or open ' + FileName;
  62.       raise;
  63.     end;
  64.   end;
  65. end;
  66.  
  67. destructor TDataFile.Destroy;
  68. begin
  69.   if TFileRec(FDataFile).Mode = fmInOut then
  70.     CloseFile(FDataFile);
  71.   inherited Destroy;
  72. end;
  73.  
  74. function TDataFile.GetCount: Longint;
  75. begin
  76.   Result := FileSize(FDataFile);
  77. end;
  78.  
  79. function TDataFile.GetCurrent: Longint;
  80. begin
  81.   Result := FilePos(FDataFile);
  82. end;
  83.  
  84. function TDataFile.GetRecord(Index: Longint): TDataRec;
  85. var
  86.   Count: Cardinal;
  87. begin
  88.   Current := Index;
  89.   BlockRead(FDataFile, Result, 1, Count);
  90.   if Count < 1 then
  91.     raise EListError.CreateRes(SListIndexError);
  92.   { Go back to the beginning of the read record }
  93.   Current := Index;
  94. end;
  95.  
  96. procedure TDataFile.SetCurrent(RecNo: Longint);
  97. begin
  98.   { Anything past EOF is considered EOF }
  99.   if RecNo > Count then
  100.     RecNo := Count;
  101.   Seek(FDataFile, RecNo);
  102. end;
  103.  
  104. procedure TDataFile.SetRecord(Index: Longint; const DataRec: TDataRec);
  105. var
  106.   X: EInOutError;
  107.   Count: Cardinal;
  108. begin
  109.   Current := Index;
  110.   if not LockFileVar(FDataFile, Current, False) then
  111.   begin
  112.     X := EInOutError.Create('Cannot lock file');
  113.     { Set up a file access denied type exception }
  114.     X.ErrorCode := 5;
  115.     raise X;
  116.   end;
  117.   try
  118.     { DataRec is passed as a const (pass by reference, but }
  119.     { not allowed to be treated/passed as a var parameter). }
  120.     { We can get around this by dereferencing its }
  121.     { address with an appropriate typecast }
  122.     BlockWrite(FDataFile, TDataRec((@DataRec)^), 1, Count);
  123.     if Count < 1 then
  124.       raise EInOutError.Create('Cannot write to file');
  125.     { Go back to the beginning of the written record }
  126.     Current := Index;
  127.   finally
  128.     LockFileVar(FDataFile, Current, False);
  129.   end;
  130. end;
  131.  
  132. end.
  133.